home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 68.7z
/
BS1 part 68
/
InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).7z
/
InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).adf
/
PC_Tools.LZH
/
ALISP.ZIP
/
CHG-FACE.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-10-06
|
4KB
|
110 lines
; CHG-FACE.LSP by Stephen Dodd 7/12/92
;
; This program will provide a way to edit 3DFACES in a way similar to the
; PEDIT command, allowing the user to toggle visibility of individual edges
; and move vertexes.
;
; ***************************************************************************
(defun CHG-FACE ( / F N A K E E1 E2 E3 E4 Emax P Pmax P1 P2 P3 P4 N PB D Q X1 X2 X3 X4 )
;--------------------------- SELECT ENTITY ---------------------------------;
(while (/= "3DFACE" (cdr(assoc 0 (setq F (entget(setq N (car(entsel)))))))))
;------------------------- INITIALIZE SETTINGS -----------------------------;
(setq A (cdr(assoc 70 F)) K 177 E 1 E1 0 E2 0 E3 0 E4 0 Emax 3 P 1 Pmax 6
P1 (trans(cdr(assoc 10 F)) N 1) P2 (trans(cdr(assoc 11 F)) N 1) D "N"
P3 (trans(cdr(assoc 12 F)) N 1) X1 NIL X2 NIL X3 NIL X4 NIL
)
(if(assoc 13 F) (setq P4 (trans(cdr(assoc 13 F)) N 1) Emax 4 Pmax 8))
(if(>= A 8)(setq E4 8 A (- A 8))) (if(>= A 4)(setq E3 4 A (- A 4)))
(if(>= A 2)(setq E2 2 A (- A 2))) (if(>= A 1)(setq E1 1 A (- A 1)))
;------------------------------ START EDITOR -------------------------------;
(while(not(member K '(1 88 120)))
;----------------------- ERASE TEMPORARY VECTORS ---------------------------;
(draw-x P1 0) (draw-x P2 0) (draw-x P3 0) (draw-x P4 0)
;--------------- INK or XOR-INK EDGES depending on VISIBILITY ---------------;
(grdraw P1 P2 4 (if(= E1 0) 0 1)) (grdraw P2 P3 4 (if(= E2 0) 0 1))
(grdraw P3 P4 4 (if(= E3 0) 0 1)) (grdraw P4 P1 4 (if(= E4 0) 0 1))
;---------------------- HIGHLIGHT SELECTED EDGE OR POINT --------------------;
(cond
((= P 1)(draw-x P1 2)) ((= P 2)(grdraw P1 P2 2 (if(= E1 0) 0 1)))
((= P 3)(draw-x P2 2)) ((= P 4)(grdraw P2 P3 2 (if(= E2 0) 0 1)))
((= P 5)(draw-x P3 2)) ((= P 6)(grdraw P3 P4 2 (if(= E3 0) 0 1)))
((= P 7)(draw-x P4 2)) ((= P 8)(grdraw P4 P1 2 (if(= E4 0) 0 1)))
)
;---------------------------- OBTAIN USER INPUT -----------------------------;
(if(member P '(2 4 6 8))(setq Q "Change visibility")(setq Q "Move vertex"))
(prompt(strcat "\rNext/Previous/" Q "/eXit<" D "> "))
(setq K (cadr(grread)))
(cond
((or(= K 67)(= K 99)) ;Cc
(cond
((= P 2)(setq E1 (IF (= 0 E1) 1 0)))
((= P 4)(setq E2 (IF (= 0 E2) 2 0)))
((= P 6)(setq E3 (IF (= 0 E3) 4 0)))
((= P 8)(setq E4 (IF (= 0 E4) 8 0)))
)
)
((or(= K 77)(= K 109)) ;Mm
(progn
(cond
((= P 1)(setq X1 (getpoint P1 "New location")))
((= P 3)(setq X2 (getpoint P2 "New location")))
((= P 5)(setq X3 (getpoint P3 "New location")))
((= P 7)(setq X4 (getpoint P4 "New location")))
)
(grdraw P1 P2 0) (grdraw P2 P3 0) (grdraw P3 P4 0) (grdraw P4 P1 0)
(cond
( X1 (setq P1 X1 X1 NIL)) ( X2 (setq P2 X2 X2 NIL))
( X3 (setq P3 X3 X3 NIL)) ( X4 (setq P4 X4 X4 NIL))
)
)
)
((or(= K 78)(= K 110)) (setq D "N")) ;Nn
((or(= K 80)(= K 112)) (setq D "P")) ;Pp
((= K 13) ;enter
(if
(= D "N")
(setq P (if(= P Pmax) 1 (1+ P))) ;if "N"
(setq P (if(= P 1) Pmax (1- P))) ;if "P"
)
)
)
)
;----------------------- ERASE TEMPORARY VECTORS ---------------------------;
(draw-x P1 0) (draw-x P2 0) (draw-x P3 0) (draw-x P4 0)
(grdraw P1 P2 0) (grdraw P2 P3 0) (grdraw P3 P4 0) (grdraw P4 P1 0)
;---------------------------- CHANGE DATABASE -------------------------------;
(setq F (subst (cons 70 (+ E1 E2 E3 E4)) (assoc 70 F) F)
F (subst (cons 10 P1) (assoc 10 F) F)
F (subst (cons 11 P2) (assoc 11 F) F)
F (subst (cons 12 P3) (assoc 12 F) F)
)
(if P4 (setq F (subst (cons 13 P4) (assoc 13 F) F)))
(entmod F)
(princ)
)
(defun DRAW-X ( A B )
(setq PB (getvar "pickbox"))
(grdraw (polar A (* PI 0.25) PB) (polar A (* PI 1.25) PB) B 0)
(grdraw (polar A (* PI 0.75) PB) (polar A (* PI 1.75) PB) B 0)
)